Visualization of Maternal Mortality
Short Paper Assignment
Andrea L. Koch
Plot 1
###############
# LINEGRAPH #
###############
#### Create new data frame for world regions
#### Filter and merge data:
WHO_data <- read.csv("data/WHO_MMR-data-1990-2015 (1)/countryresults_all.csv")
# New table of mmr point estimates:
mmr_data <- filter(WHO_data,
indicator == "mmr",
estimate == "point estimate",
rounded == "FALSE")
WorldBank_data <- read_excel("data/WB_country_region_income.xlsx")
WorldBank_data <- WorldBank_data[,-c(3,6,7)]
# Merge WHO and WB data:
merged_WHO_WB_data <- sqldf("SELECT * from mmr_data
LEFT OUTER join WorldBank_data
ON mmr_data.iso = WorldBank_data.Code")
merged_WHO_WB_data$Region[merged_WHO_WB_data$Region %in% c("North America", "Latin America & Caribbean")] <- "NA, LATAM & Caribbean"
# group and summarize merged WHO and WB data into a new table based on world region
region_data <- summarize(group_by(merged_WHO_WB_data, year, Region),
avg_mmr=round(mean(value, na.rm=TRUE), digits=0))
#### PLOT
background_color <- "#F7F7F7"
gridline_color_light <- "#EBEBEB"
gridline_color_dark <- "#8A8A8A"
title_font <- "Raleway"
subtitle_font <- "PT Mono"
caption_font <- "PT Mono"
directlabel_font <- "PT Mono"
region_data2 <- region_data
# show_years <- c(2015, 2010, 2005, 2000, 1995, 1990, 1985)
# region_data2 <- subset(region_data2, year %in% show_years)
df <- region_data2
ggplot(data = df, aes(x = year, y = avg_mmr, group = Region)) +
geom_line(aes(color = Region), size = 1.15) +
geom_text(data = df %>% filter(year == 1995 & Region %in% c("Sub-Saharan Africa", "South Asia", "East Asia & Pacific")),
aes(label = Region, color = Region),
nudge_x = 0.5,
nudge_y = 25,
hjust = "left",
fontface = "bold",
size = 3,
family = directlabel_font) +
geom_text(data = df %>% filter(year == 1995 & Region %in% c("East Asia & Pacific")),
aes(label = Region, color = Region),
nudge_x = 0.5,
nudge_y = 25,
hjust = "left",
fontface = "bold",
size = 3,
family = directlabel_font) +
geom_text(data = df %>% filter(year == 1995 & Region %in% c("Europe & Central Asia")),
aes(label = Region, color = Region),
nudge_x = 0.5,
nudge_y = -25,
hjust = "left",
fontface = "bold",
size = 3,
family = directlabel_font) +
geom_text(data = df %>% filter(year == 1995 & Region %in% c("NA, LATAM & Caribbean")),
aes(label = Region, color = Region),
nudge_x = 0.5,
nudge_y = 25,
fontface = "bold",
size = 3,
family = directlabel_font) +
geom_text(data = df %>% filter(year == 1995 & Region %in% c("Middle East & North Africa")),
aes(label = Region, color = Region),
nudge_x = 0.5,
nudge_y = -25,
fontface = "bold",
size = 3,
family = directlabel_font) +
scale_color_manual(values = rev(c("#7102FA", "#D46224", "#357797", "#948E00", "#13394A", "#CC149B"))) +
scale_x_continuous(breaks = seq(1985, 2015, 5)) +
labs(title = "",
subtitle = "",
caption = "Source(s): The World Health Organization / The World Bank") +
xlab("Year") +
ylab("Deaths per 100,000 live births") +
theme(
axis.title = element_text(size = 10, family = "PT Mono", face = "bold", color = "black"),
axis.title.x = element_text(margin = margin(t=0.5, r=0, b=0, l=0, unit="cm")),
axis.title.y = element_text(margin = margin(t=0, r=0.5, b=0, l=0, unit="cm")),
axis.text = element_text(size = 10, family = "PT Mono", color = "black"),
axis.text.x = element_text(margin = margin(t=.5, r=0, b=0, l=0, unit="cm")),
axis.ticks = element_blank(),
legend.position = "none",
panel.border = element_blank(),
panel.background = element_rect(fill = background_color),
panel.grid.major.x = element_line(color = gridline_color_light),
panel.grid.minor.x = element_blank(),
panel.grid.major.y = element_line(color = gridline_color_light),
panel.grid.minor.y = element_line(color = gridline_color_light),
plot.title = element_text(size = 20, family = "Raleway", face = "bold"),
plot.subtitle = element_text(size = 10, family = "PT Mono",
margin = margin(t=0,r=0,b=1.5,l=0,unit="cm")),
plot.caption = element_text(size = 8,
family = "PT Mono",
margin = margin(t=1.5,r=0,b=0,l=0,unit="cm"),
hjust = 1),
plot.margin = unit(c(.5,.5,.5,.5),"in"),
plot.background = element_rect(fill = background_color)
) +
coord_cartesian(xlim = c(1985,2015), ylim = c(1,max(df$avg_mmr)), clip = "off") +
annotate("text", x = 1985, y = 1150, label = "How has maternal mortality changed globally?", size = 8.5, hjust = 0, fontface = "bold", family = title_font) +
annotate("text", x = 1985, y = 1100, label = "Average number of deaths per 100,000 live births by global region", size = 4, hjust = 0, family = subtitle_font)
Overall, maternal mortality ratios around the world have decreased in the last 30 years. However, maternal mortality remains high among childbearing women in Sub-Saharan African countries (482 maternal deaths per 100,000 live births). South Asian countries had a significant drop in maternal mortality, from 883 deaths to 179 deaths per live births.
Plot 2
#######################
# STACKED BAR CHART #
#######################
#### PREP
# read in World Health Organization data
WHO_data <- read.csv("data/WHO_MMR-data-1990-2015 (1)/countryresults_all.csv")
# read and clean World Bank data
WorldBank_data <- read_excel("data/old data/world bank data.xlsx")
WorldBank_data <- WorldBank_data[-c(1),]
WorldBank_data <- WorldBank_data[,-c(1,2,5)]
# create a new table of maternal mortality ratio point estimates
matdeath_data <- filter(WHO_data,
indicator == "matdeaths",
estimate == "point estimate",
rounded == "TRUE")
# merge WHO and WB data
new_data <- sqldf("SELECT * from matdeath_data
LEFT OUTER join WorldBank_data
ON matdeath_data.iso = WorldBank_data.Code")
show_years <- c(2015, 2010, 2005, 2000, 1995, 1990, 1985)
new_data <- subset(new_data, year %in% show_years)
rollup_new_data <- new_data
rollup_new_data$Region[rollup_new_data$Region %in% c("North America", "Latin America & Caribbean")] <- "North Amer. & Latin Amer. & Caribbean"
# group and summarize into a new table
sum_region_data <- summarize(group_by(rollup_new_data, year, Region),
total_matdeaths_region = round(sum(value, na.rm=TRUE), digits=0))
sum_year_data <- summarize(group_by(sum_region_data, year),
total_matdeaths_year = sum(total_matdeaths_region, na.rm=TRUE))
merge_data <- merge(sum_region_data, sum_year_data, by="year")
#### PLOT
df <- merge_data
gridline_color <- "#8A8A8A"
background_color <- "#F7F7F7"
stackedbar_colors <- rev(c("#7102FA", "#D46224", "#357797", "#E3DD44", "#13394A", "#CC149B"))
geomtext_font <- "PT Mono"
ggplot(df, aes(x = year, y = total_matdeaths_region, fill = Region)) +
geom_bar(stat = "identity", alpha = 0.85) +
scale_fill_manual(values = stackedbar_colors) +
scale_x_continuous(breaks = seq(1985, 2015, 5)) +
scale_y_continuous(labels = scales::comma) +
geom_text(aes(y = total_matdeaths_year, label = total_matdeaths_year),
size = 5,
vjust = -.7,
colour = "black",
family = geomtext_font,
face = "bold") +
labs(title = "Total number of maternal deaths decrease in all world\nregions except Sub-Saharan Africa",
subtitle = "Total maternal deaths from 1985 to 2015",
caption = "Source(s): The World Health Organization / The World Bank") +
xlab("Year") +
ylab("Total maternal deaths") +
theme(
axis.title = element_text(size = 10, family = "PT Mono", face = "bold", color = "black"),
axis.title.x = element_text(margin = margin(t=0.3, r=0, b=0, l=0, unit="cm")),
axis.title.y = element_text(margin = margin(t=0, r=0.3, b=0, l=0, unit="cm")),
axis.text = element_text(size = 10, family = "PT Mono", color = "black"),
axis.text.x = element_text(angle = 45, margin = margin(t=.5, r=0, b=0, l=0, unit="cm")),
axis.ticks = element_blank(),
legend.position = "bottom",
legend.background = element_rect(fill = "#F7F7F7"),
legend.title = element_text(family = "PT Mono"),
legend.text = element_text(family = "PT Mono"),
panel.border = element_blank(),
panel.background = element_rect(fill = "#F7F7F7"),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.y = element_line(color = "#8A8A8A"),
panel.grid.minor.y = element_line(color = "#8A8A8A"),
plot.title = element_text(size = 20, family = "Raleway", face = "bold"),
plot.subtitle = element_text(size = 10, family = "PT Mono",
margin = margin(t=0,r=0,b=1.5,l=0,unit="cm")),
plot.caption = element_text(size = 8,
family = "PT Mono",
margin = margin(t=1.5,r=0,b=0,l=0,unit="cm"),
hjust = 1),
plot.margin = unit(c(1,1,1,1),"cm"),
plot.background = element_rect(fill = "#F7F7F7")
) +
coord_cartesian(clip = "off")
The prior line chart shows that maternal mortality ratios have decreased, and we see in this stacked bar chart that total Sub-Saharan African maternal deaths remains the same around 200,000. While live births have increased in Sub-Saharan Africa, childbearing women in those countries have continued to die at the same levels over the past 30 years. Total maternal deaths in Europe & Central Asia are so low compared to other regions that they almost appear invisible by 2015.
Plot 3
##############################################
# WORLD CHOROPLETH - birth attendance rates #
##############################################
skilled_staff <- read.csv("~/Desktop/Data Visualization/DV Maternal Mortality/data/births-attended-by-health-staff-sdgs.csv", na.strings = c(""))
names(skilled_staff)[4] <- "pct_attended"
skilled_staff <- na.omit(skilled_staff)
skilled_staff.agg <- aggregate(Year ~ Code, skilled_staff, max)
skilled_staff.max <- merge(skilled_staff.agg, skilled_staff)
skilled_staff.max <- subset(skilled_staff.max, Year >= 2010)
#Citation for finding most recent year: https://nsaunders.wordpress.com/2013/02/13/basic-r-rows-that-contain-the-maximum-value-of-a-variable/
colnames(skilled_staff.max) <- paste("Staff", colnames(skilled_staff.max), sep = "_")
skilled_staff.max <- mutate(skilled_staff.max, Staff_pct_groups = case_when(Staff_pct_attended < 25 ~ 15, Staff_pct_attended >= 25 & Staff_pct_attended < 50 ~ 40, Staff_pct_attended >= 50 & Staff_pct_attended < 75 ~ 65, Staff_pct_attended >= 75 ~ 90))
counts <- skilled_staff.max %>% group_by(Staff_pct_groups) %>% tally()
world <- ne_countries(scale = "medium", returnclass = "sf")
world_points<- st_centroid(world)
world_points <- cbind(world, st_coordinates(st_centroid(world$geometry)))
merge_w_Staff <- left_join(world_points, skilled_staff.max, c("iso_a3" = "Staff_Code"))
##### PLOT
df <- merge_w_Staff
(world_plot <- ggplot() +
geom_sf(data = df, aes(fill = factor(Staff_pct_groups)), lwd = 0.1, color = "white") +
scale_fill_manual(values = c("#E3DD44", "#BD9840", "#974BBD", "#7102FA"), na.value = "#dedede") +
geom_text_repel(data = filter(df, iso_a3 == "SSD"),
aes(x = X, y = Y, label = paste0(name, " (", Staff_pct_attended, "%)")),
nudge_x = 40,
nudge_y = -15,
family = "PT Mono",
size = 3) +
geom_text_repel(data = filter(df, iso_a3 == "TCD"),
aes(x = X, y = Y, label = paste0(name, " (", Staff_pct_attended, "%)")),
nudge_x = -30,
nudge_y = -20,
family = "PT Mono",
size = 3) +
coord_sf(clip = "off") +
labs(title = "Women in Some African and South Asian Countries Face\nIssues of Access to Skilled Care During Birth",
subtitle = "Percent of births attended by skilled health staff",
caption = "Source(s): Our World in Data") +
theme(
axis.title = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
legend.position = "none",
legend.background = element_rect(fill = "#F7F7F7"),
legend.title = element_text(family = "PT Mono"),
legend.text = element_text(family = "PT Mono"),
panel.border = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.background = element_rect(fill = "#F7F7F7"),
plot.title = element_text(size = 21, family = "Raleway", face = "bold"),
plot.subtitle = element_text(size = 12, family = "PT Mono",
margin = margin(t=0,r=0,b=1,l=0,unit="cm")),
plot.caption = element_text(size = 8,
family = "PT Mono",
margin = margin(t=1.5,r=0,b=0,l=0,unit="cm"),
hjust = 1),
plot.margin = unit(c(0.5, 0.5, 0.5, 0.5),"cm"),
plot.background = element_rect(fill = "#F7F7F7")
)
)
df1 <- data.frame(counts)
(bar_plot <- ggplot(data = df1, aes(x = Staff_pct_groups, y = n, fill = factor(Staff_pct_groups))) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("#E3DD44", "#BD9840", "#974BBD", "#7102FA")) +
scale_x_continuous(breaks = c(0, 25, 50, 75, 100), labels = c("0%", "25%", "50%", "75%", "100%")) +
geom_text(data = filter(df1, Staff_pct_groups == 90),
aes(y = n, label = n),
size = 7,
nudge_y = -7,
colour = "white",
family = "PT Mono",
face = "bold") +
geom_text(data = filter(df1, Staff_pct_groups == 65),
aes(y = n, label = n),
size = 7,
nudge_y = 5,
colour = "black",
family = "PT Mono",
face = "bold") +
geom_text(data = filter(df1, Staff_pct_groups == 40),
aes(y = n, label = n),
size = 7,
nudge_y = 5,
colour = "black",
family = "PT Mono",
face = "bold") +
geom_text(data = filter(df1, Staff_pct_groups == 15),
aes(y = n, label = n),
size = 7,
nudge_y = 4,
colour = "black",
family = "PT Mono",
face = "bold") +
coord_flip() +
xlab("Percent births attended by skilled staff") +
ylab("Number of countries") +
theme(
axis.title = element_text(size = 10, family = "PT Mono", face = "bold", color = "black"),
axis.title.x = element_text(margin = margin(t=0.3, r=0, b=0, l=0, unit="cm")),
axis.title.y = element_text(margin = margin(t=0, r=0.3, b=0, l=0, unit="cm")),
axis.ticks = element_blank(),
axis.text = element_text(family = "PT Mono", color = "black"),
axis.text.x = element_text(),
axis.text.y = element_text(),
legend.position = "none",
panel.border = element_blank(),
panel.grid.major.y = element_line(color = "#8A8A8A"),
panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_line(color = "#8A8A8A"),
panel.grid.minor.x = element_blank(),
panel.background = element_rect(fill = "#F7F7F7"),
plot.title = element_text(size = 21, family = "Raleway", face = "bold"),
plot.subtitle = element_text(size = 12, family = "PT Mono",
margin = margin(t=0,r=0,b=1.5,l=0,unit="cm")),
plot.caption = element_text(size = 8,
family = "PT Mono",
margin = margin(t=1.5,r=0,b=0,l=0,unit="cm"),
hjust = 1),
plot.margin = unit(c(0.5, 0.5, 0.5, 0.5),"cm"),
plot.background = element_rect(fill = "#F7F7F7")
)
)
df2 <- skilled_staff.max
(bar_plot2 <- ggplot(data = df2, aes(x = reorder(Staff_Code, Staff_pct_attended), y = Staff_pct_attended, fill = factor(Staff_pct_groups))) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("#E3DD44", "#BD9840", "#974BBD", "#7102FA")) +
xlab("Countries") +
ylab("Percent births attended by skilled staff") +
theme(
axis.title = element_text(size = 10, family = "PT Mono", face = "bold", color = "black"),
axis.title.x = element_text(margin = margin(t=0.3, r=0, b=0, l=0, unit="cm")),
axis.title.y = element_text(margin = margin(t=0, r=0.3, b=0, l=0, unit="cm")),
axis.ticks = element_blank(),
axis.text = element_text(family = "PT Mono", color = "black"),
axis.text.x = element_blank(),
axis.text.y = element_text(),
legend.position = "none",
panel.border = element_blank(),
panel.grid.major.y = element_line(color = "#8A8A8A"),
panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.background = element_rect(fill = "#F7F7F7"),
plot.title = element_text(size = 21, family = "Raleway", face = "bold"),
plot.subtitle = element_text(size = 12, family = "PT Mono",
margin = margin(t=0,r=0,b=1.5,l=0,unit="cm")),
plot.caption = element_text(size = 8,
family = "PT Mono",
margin = margin(t=1.5,r=0,b=0,l=0,unit="cm"),
hjust = 1),
plot.margin = unit(c(0.5, 0.5, 0.5, 0.5),"cm"),
plot.background = element_rect(fill = "#F7F7F7")
)
)
# plots <- align_plots(world_plot, bar_plot, align = 'v', axis = 'l')
# world_plot +
# annotation_custom(grob = ggplotGrob(bar_chart), xmin = -120, xmax = -60, ymin = -50, ymax = -0)African and South Asian countries face issues of access to births attended by skilled staff. The Republic of Chad and the Republic of South Sudan have significantly lower percentages of births attended by skilled staff of 20.2% and 19.4%, respectively. The majority of countries have a minimum of 75% of births attended by skilled health staff.
(Notes: Skilled health staff includes doctors, nurses, midwives, or auxiliary midwives. Data reflects each country’s most recent survey results. Most recent survey years range from 2010 to 2016.)
Plot 4
#######################
# BUMPCHART #
# plot upper income #
#######################
#### Filter and merge data:
WHO_data <- read.csv("data/WHO_MMR-data-1990-2015 (1)/countryresults_all.csv")
# New table of mmr point estimates:
mmr_data <- filter(WHO_data,
indicator == "mmr",
estimate == "point estimate",
rounded == "FALSE")
WorldBank_data <- read_excel("data/WB_country_region_income.xlsx")
WorldBank_data <- WorldBank_data[,-c(3,6,7)]
# Merge WHO and WB data:
merged_WHO_WB_data <- sqldf("SELECT * from mmr_data
LEFT OUTER join WorldBank_data
ON mmr_data.iso = WorldBank_data.Code")
#### Create subsets by income, then rank countries by maternal mortality ratio (mmr):
upper_income_countries <- filter(merged_WHO_WB_data, `Income group` == "High income")
ranked_mmr_of_upper_income <- arrange(upper_income_countries, year, value) %>%
group_by(year) %>%
mutate(rank = order(value))
#### Find changes in rank from 1985 to 2015 for:
# UPPER INCOME COUNTRIES
change_in_rank_upper <- subset(ranked_mmr_of_upper_income, year %in% c(1985, 2015))
change_in_rank_upper <- change_in_rank_upper[,-c(4:11)]
change_in_rank_upper <- spread(change_in_rank_upper, year, rank)
change_in_rank_upper[3:4] <- lapply(change_in_rank_upper[3:4], as.numeric)
change_in_rank_upper <- mutate(change_in_rank_upper, rank_change = change_in_rank_upper$`1985` - change_in_rank_upper$`2015`)
# NB: United States (USA) fell by 21 spots, Poland (POL) gained by 27 spots
# Show only every 5 years:
show_years <- c(2015, 2010, 2005, 2000, 1995, 1990, 1985)
ranked_mmr_of_upper_income$Year_formatted <- as.character(ranked_mmr_of_upper_income$year)
ranked_mmr_of_upper_income <- subset(ranked_mmr_of_upper_income, year %in% show_years)
# Note rows for USA (down) and POL (up), so that they can be highlighted later in visualization:
ranked_mmr_of_upper_income <- mutate(ranked_mmr_of_upper_income,
highlight_country = case_when(iso == "USA" ~ 1,
iso == "POL" ~ 2,
TRUE ~ 0))
#### PLOT
background_color <- "#F7F7F7"
gridline_color_light <- "#EBEBEB"
gridline_color_dark <- "#8A8A8A"
title_font <- "Raleway"
subtitle_font <- "PT Mono"
caption_font <- "PT Mono"
# NB: United States (USA) fell by 21 spots, Poland (POL) gained by 27 spots
down_color <- "#7102FA"
up_color <- "#948E00"
df <- ranked_mmr_of_upper_income
ggplot(data = df, aes(x = year, y = rank, group = iso)) +
scale_y_reverse() +
# USA:
geom_line(data = df %>% filter(iso == "USA"), alpha = 1, color = down_color, size = 1) +
geom_label(data = df %>% filter(iso == "USA"),
aes(label = rank),
size = 4,
label.padding = unit(0.05, "lines"),
label.size = 0.0,
color = down_color,
fontface = "bold",
fill = background_color,
family = "PT Mono") +
geom_text(data = df %>% filter(iso == "USA" & year == 1985),
aes(label = iso),
nudge_x = -0.8,
vjust = 0.5,
hjust = 1,
fontface = "bold",
size = 4,
color = down_color,
family = "PT Mono") +
geom_text(data = df %>% filter(iso == "USA" & year == 2015),
aes(label = iso) ,
nudge_x = 0.8,
vjust = 0.5,
hjust = 0,
fontface = "bold",
size = 4,
color = down_color,
family = "PT Mono") +
# POL:
geom_line(data = df %>% filter(iso == "POL"), alpha = 1, color = up_color, size = 1) +
geom_label(data = df %>% filter(iso == "POL"),
aes(label = rank),
size = 4,
label.padding = unit(0.05, "lines"),
label.size = 0.0,
color = up_color,
fontface = "bold",
fill = background_color,
family = "PT Mono") +
geom_text(data = df %>% filter(iso == "POL" & year == 1985),
aes(label = iso) ,
nudge_x = -0.8,
vjust = 0.5,
hjust = 1,
fontface = "bold",
size = 4,
color = up_color,
family = "PT Mono") +
geom_text(data = df %>% filter(iso == "POL" & year == 2015),
aes(label = iso) ,
nudge_x = 0.8,
vjust = 0.5,
hjust = 0,
fontface = "bold",
size = 4,
color = up_color,
family = "PT Mono") +
# Other countries:
geom_line(data = df %>% filter(!iso %in% c("USA", "POL")), color = "grey", size = 0.25) +
geom_label(data = df %>% filter(!iso %in% c("USA", "POL")),
aes(label = rank),
size = 4,
label.padding = unit(0.05, "lines"),
label.size = 0.0,
color = "grey",
fill = background_color,
family = "PT Mono") +
geom_text(data = df %>% filter(!iso %in% c("USA", "POL") & year == 1985),
aes(label = iso) ,
nudge_x = -0.8,
vjust = 0.5,
hjust = 1,
size = 4,
color = "grey",
family = "PT Mono") +
geom_text(data = df %>% filter(!iso %in% c("USA", "POL") & year == 2015),
aes(label = iso) ,
nudge_x = 0.8,
vjust = 0.5,
hjust = 0,
size = 4,
color = "grey",
family = "PT Mono") +
# show all years on x-axis:
scale_x_continuous(breaks = seq(1980, 2015, 5)) +
labs(title = "",
subtitle = "",
caption = "*as categorized by the World Bank's 2019 fiscal year estimates \nSource(s): The World Health Organization / The World Bank") +
xlab("Year") +
ylab("Country ranking") +
theme(
axis.title = element_text(size = 14, face = "bold", family = "PT Mono"),
axis.title.x = element_text(margin = margin(t=1, r=0, b=0, l=0, unit="cm")),
axis.title.y = element_text(margin = margin(t=0, r=1, b=0, l=0, unit="cm")),
axis.text = element_text(family = "PT Mono"),
axis.text.x = element_text(size=12,
angle=45,
margin = margin(t=.3, r=0, b=0, l=0, unit = "cm")),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
legend.position = "none",
panel.border = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.background = element_rect(fill = background_color),
plot.title = element_text(),
plot.subtitle = element_text(size = 10, margin = margin(t=0,r=0,b=1.5,l=0,unit="cm")),
plot.caption = element_text(size = 8,
margin = margin(t=0.35,r=0,b=0,l=0,unit="in"),
hjust = 1,
face = "italic",
family = "PT Mono"),
plot.margin = unit(c(1.5,1.5,1.5,1.5),"cm"),
plot.background = element_rect(fill = background_color)
) +
coord_cartesian(xlim = c(1985,2015), ylim = c(1,52), clip = "off") +
annotate("text", x = 1985, y = -6, hjust = 0, parse=T, label=expression(bold("United States") * phantom(bold(" falls in maternal health; ")) * phantom(bold("Poland")) * phantom(bold(" improves the most"))), color = down_color, size = 7, family = "Raleway") +
annotate("text", x = 1985, y = -6, hjust = 0, parse=T, label=expression(phantom(bold("United States")) * bold(" falls in maternal health; ") * phantom(bold("Poland")) * phantom(bold(" improves the most"))), color = "black", size = 7, family = "Raleway") +
annotate("text", x = 1985, y = -6, hjust = 0, parse=T, label=expression(phantom(bold("United States")) * phantom(bold(" falls in maternal health; ")) * bold("Poland") * phantom(bold(" improves the most"))), color = up_color, size = 7, family = "Raleway") +
annotate("text", x = 1985, y = -6, hjust = 0, parse=T, label=expression(phantom(bold("United States")) * phantom(bold(" falls in maternal health; ")) * phantom(bold("Poland")) * bold(" improves the most")), color = "black", size = 7, family = "Raleway") +
annotate("text", x = 1985, y = -4, hjust = 0, label = "Ranking of maternal mortality ratios of high-income* countries", size = 4, family = "PT Mono") +
annotate("text", x=2012.5, y=47, label="HIGH\nmortality\nratio", hjust = 0.5, size = 4, color = down_color, fontface = "bold.italic", family = "PT Mono") +
annotate("text", x=2012.5, y=6, label="LOW\nmortality\nratio", hjust = 0.5, size = 4, color = up_color, fontface = "bold.italic", family = "PT Mono") 
From 1985 to 2015, the United States had the greatest drop in maternal mortality health rankings among high-income countries. The U.S. fell by 21 spots, where as Poland increased by 27 spots. Poland attributes some of its success to its “Childbirth with Dignity” human and women’s rights campaign, which started over two decades ago, resulting in its Ministry of Health issuing Perinatal and Postnatal Care Standards in 2011. (Source(s): https://www.ncbi.nlm.nih.gov/pmc/articles/PMC5474903/, https://www.who.int/features/2015/childbirth-dignity-poland/en/.)
Plot 5 - using sf()
#####################
# US - CHOROPLETH #
#####################
shape <- read_sf(dsn = "~/Desktop/Data Visualization/DV Maternal Mortality/data/states_21basic/", layer = "states")
AHR_2018data <- read.csv("data/2018-HWC (4).csv")
AHR_2018allstates <- filter(AHR_2018data, AHR_2018data$Measure.Name == "Maternal Mortality")
AHR_2018allstates <- filter(AHR_2018allstates, State.Name != "United States") #remove "US" observation
AHR_2018allstates <- mutate(AHR_2018allstates, quantile_rank = ntile(AHR_2018allstates$Value, 5))
AHR_2018allstates$State.Name <- as.character(AHR_2018allstates$State.Name)
merged_data <- left_join(shape, AHR_2018allstates, c("STATE_NAME"= "State.Name"))
ggplot() +
geom_sf(data = merged_data, aes(fill = factor(quantile_rank))) +
scale_fill_manual(values = rev(c("#E3DD44", "#C6A671", "#AA6F9F", "#8D38CC", "#7102FA")), na.value = "#dedede") +
geom_path()+
coord_sf() +
labs(title = "U.S. Maternal Death Prevalent in the South and West",
subtitle = "2018 maternal deaths per 100,000 live births",
caption = "Source(s): America's Health Rankings") +
theme(
axis.title = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
legend.position = "none",
panel.border = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.background = element_rect(fill = "#F7F7F7"),
plot.title = element_text(size = 21, family = "Raleway", face = "bold"),
plot.subtitle = element_text(size = 12, family = "PT Mono",
margin = margin(t=0,r=0,b=1.5,l=0,unit="cm")),
plot.caption = element_text(size = 8,
family = "PT Mono",
margin = margin(t=1.5,r=0,b=0,l=0,unit="cm"),
hjust = 1),
plot.margin = unit(c(0.5, 0.5, 0.5, 0.5),"cm"),
plot.background = element_rect(fill = "#F7F7F7")
) 
#### PLOT 2
stateabbr2 = data.frame(name=c("District of Columbia", "United States"), abbr=c("DC", "USA"))
stateabbr = data.frame(name=state.name, abbr=state.abb)
stateNabb <- rbind(stateabbr, stateabbr2)
US_mmr <- merge(AHR_2018allstates, stateNabb, by.x = c("State.Name"), by.y = c("name"))
US_mmr <- filter(US_mmr, !abbr %in% c("VT", "AK"))
df <- US_mmr
ggplot(df, aes(x = reorder(abbr, Value), y = Value, fill = factor(quantile_rank))) +
geom_bar(stat = "identity") +
scale_fill_manual(values = rev(c("#E3DD44", "#C6A671", "#AA6F9F", "#8D38CC", "#7102FA")), na.value = "#dedede") +
geom_text(data = df %>% filter(quantile_rank == 1), aes(label = abbr), angle = 90, color = "white", nudge_y = -1.5, family = "PT Mono") +
geom_text(data = df %>% filter(quantile_rank == 2), aes(label = abbr), angle = 90, color = "white", nudge_y = -1.5, family = "PT Mono") +
geom_text(data = df %>% filter(quantile_rank == 3), aes(label = abbr), angle = 90, color = "white", nudge_y = -1.5, family = "PT Mono") +
geom_text(data = df %>% filter(quantile_rank == 4), aes(label = abbr), angle = 90, color = "black", nudge_y = -1.5, family = "PT Mono") +
geom_text(data = df %>% filter(quantile_rank == 5), aes(label = abbr), angle = 90, color = "black", nudge_y = -1.5, family = "PT Mono") +
labs(title = "",
subtitle = "",
caption = "Source(s): America's Health Rankings",
fill = "Maternal deaths per 100,000 live births") +
xlab("States") +
ylab("Deaths per 100,000 live births") +
theme(
axis.title = element_text(size = 10, family = "PT Mono", face = "bold", color = "black"),
axis.title.x = element_text(margin = margin(t=0.3, r=0, b=0, l=0, unit="cm")),
axis.title.y = element_text(margin = margin(t=0, r=0.3, b=0, l=0, unit="cm")),
axis.ticks = element_blank(),
axis.text.y = element_text(size = 10, family = "PT Mono", color = "black"),
axis.text.x = element_blank(),
legend.position = "none",
legend.background = element_rect(fill = "#F7F7F7"),
legend.text = element_text(family = "PT Mono"),
legend.title = element_text(family = "PT Mono"),
panel.border = element_blank(),
panel.background = element_rect(fill = "#F7F7F7"),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.y = element_line(color = "#8A8A8A"),
panel.grid.minor.y = element_line(color = "#8A8A8A"),
plot.title = element_text(size = 21, family = "Raleway", face = "bold"),
plot.subtitle = element_text(size = 12, family = "PT Mono",
margin = margin(t=0,r=0,b=1.5,l=0,unit="cm")),
plot.caption = element_text(size = 8,
family = "PT Mono",
margin = margin(t=1.5,r=0,b=0,l=0,unit="cm"),
hjust = 1),
plot.margin = unit(c(1,1,1,1),"cm"),
plot.background = element_rect(fill = "#F7F7F7")
)
#code for heatmap of US from https://stackoverflow.com/questions/24441775/how-do-you-create-a-us-states-heatmap-based-on-some-valuesAbove visualizes maternal deaths per 100,000 live births, inclusive of deaths that occur during gestation and up to 42 days after termination of pregnancy. The increasing ratio of maternal mortality is spread throughout the United States. Only a few states (California, Massachusetts, and Nevada) have low mortality ratios. Note: Data not available for Alaska and Vermont.
Plot 6
###############################
# SCATTER PLOT - US Regions #
###############################
AHR_data <- read.csv("data/2018-HWC (4).csv")
AHR_by_region <- filter(AHR_data, AHR_data$Measure.Name == "Maternal Mortality")
#If you want region of the country:
northeast <- c("Connecticut", "Maine", "Massachusetts", "New Hampshire", "Rhode Island", "Vermont", "New Jersey", "New York", "Pennsylvania")
midwest <- c("Illinois","Indiana","Michigan","Ohio","Wisconsin","Iowa","Kansas","Minnesota","Missouri","Nebraska","North Dakota","South Dakota")
south <- c("Delaware","District of Columbia","Florida","Georgia","Maryland","North Carolina","South Carolina","Virginia","West Virginia","Alabama","Kentucky","Mississippi","Tennessee","Arkansas","Louisiana","Oklahoma","Texas")
west <- c("Arizona","Colorado","Idaho","Montana","Nevada","New Mexico","Utah","Wyoming","Alaska","California","Hawaii","Oregon","Washington")
AHR_by_region <- mutate(AHR_by_region, Region = case_when(State.Name %in% northeast ~ "Northeast",
State.Name %in% midwest ~ "Midwest",
State.Name %in% south ~ "South",
State.Name %in% west ~ "West"))
AHR_by_region <- drop_na(AHR_by_region, c("Value"))
AHR_by_region <- filter(AHR_by_region, State.Name != "United States") #remove "US" observation
# if labeling states
stateabbr2 = data.frame(name=c("District of Columbia", "United States"), abbr=c("DC", "USA"))
stateabbr = data.frame(name=state.name, abbr=state.abb)
stateNabb <- rbind(stateabbr, stateabbr2)
AHR_by_region2 <- merge(AHR_by_region, stateNabb, by.x = c("State.Name"), by.y = c("name"))
region_colors <- c("#CC149B", "#E3DD44", "#948E00", "#357797")
gridlinecolor <- "#EBEBEB"
df <- AHR_by_region2
ggplot(df, aes(x = Value, y = Region, colour = Region)) +
geom_jitter(size = 5, alpha = 0.7) +
scale_colour_manual(values = region_colors) +
labs(title = "More American women are dying in the South",
subtitle = "2018 state maternal mortality ratios",
caption = "Source(s): America's Health Rankings") +
xlab("Deaths per 100,000 live births") +
ylab("U.S. Region") +
theme(
axis.title = element_text(size = 10, family = "PT Mono", face = "bold", color = "black"),
axis.title.x = element_text(margin = margin(t=0.5, r=0, b=0, l=0, unit="cm")),
axis.title.y = element_text(margin = margin(t=0, r=0.5, b=0, l=0, unit="cm")),
axis.text = element_text(size = 10, family = "PT Mono", color = "black"),
axis.ticks = element_blank(),
legend.position = "none",
panel.border = element_blank(),
panel.background = element_rect(fill = "#F7F7F7"),
panel.grid.major.x = element_line(color = "#EBEBEB"),
panel.grid.minor.x = element_blank(),
panel.grid.major.y = element_line(color = "#EBEBEB"),
panel.grid.minor.y = element_blank(),
plot.title = element_text(size = 21, family = "Raleway", face = "bold"),
plot.subtitle = element_text(size = 12, family = "PT Mono",
margin = margin(t=0,r=0,b=1.5,l=0,unit="cm")),
plot.caption = element_text(size = 8,
family = "PT Mono",
margin = margin(t=1.5,r=0,b=0,l=0,unit="cm"),
hjust = 1),
plot.margin = unit(c(1,1,1,1),"cm"),
plot.background = element_rect(fill = "#F7F7F7")
) +
coord_cartesian(clip = "off") 
Where are American women dying? State maternal mortality ratios show higher prevalence of maternal deaths in the South and Midwest. Georgia shows the highest ratio of death being 46.2 deaths per 100,000 live births. The West has overall lower maternal mortality ratios, the greatest ratio being 25.6 deaths per 100,000 live births in New Mexico.
Plot 7
####################
# DOT PLOT - Race #
####################
AHR_data <- read.csv("data/2018-HWC (4).csv")
keep <- c("Maternal Mortality - AIAN","Maternal Mortality - Asian/Pacific Islander","Maternal Mortality - Black","Maternal Mortality - Hispanic","Maternal Mortality - White")
AHR_mmr_by_race <- filter(AHR_data, AHR_data$Measure.Name %in% keep)
AHR_mmr_by_race <- drop_na(AHR_mmr_by_race, c("Value"))
AHR_mmr_by_race <- filter(AHR_mmr_by_race, State.Name != "United States") #remove "US" observation
AHR_mmr_by_race <- mutate(AHR_mmr_by_race,
Race = case_when(
Measure.Name == "Maternal Mortality - AIAN" ~ "Other",
Measure.Name == "Maternal Mortality - Asian/Pacific Islander" ~ "Other",
Measure.Name == "Maternal Mortality - Black" ~ "Black",
Measure.Name == "Maternal Mortality - Hispanic" ~ "Other",
Measure.Name == "Maternal Mortality - White" ~ "White"))
#get state abbreviations
stateabbr2 = data.frame(name=c("District of Columbia"), abbr=c("DC"))
stateabbr = data.frame(name=state.name, abbr=state.abb)
stateNabb <- rbind(stateabbr, stateabbr2)
AHR_race <- merge(AHR_mmr_by_race, stateNabb, by.x = c("State.Name"), by.y = c("name"))
segcolor <- "#4A4A4A"
racecolors <- c("#7102FA", "#E3DD44", "#948E00", "#357797")
df <- AHR_race
df$Race <- factor(df$Race, levels=c("Other", "Black", "White")) #reorder cateogrical variable for plotting
ggplot(df, aes(x = Race, y = Value, colour = Race)) +
geom_point(size = 5, alpha = 0.7) +
#OTHER
geom_text(data = df %>% filter(Race == "Other" & Measure.Name == "Maternal Mortality - AIAN" & abbr == "AZ"), aes(label = abbr), color = "black", vjust = "center", nudge_x = 0.15, family = "PT Mono") +
geom_text(data = df %>% filter(Race == "Other" & Measure.Name == "Maternal Mortality - Hispanic" & abbr == "CA"), aes(label = abbr), color = "black", vjust = "center", nudge_x = 0.15, family = "PT Mono") +
# geom_text(data = df %>% filter(Race == "Other" & Measure.Name == "Maternal Mortality - AIAN" & abbr == "AZ"), aes(label = "Other"), color = "black", vjust = "top", hjust = "center", nudge_y = 5, size = 4, face = "bold", family = "PT Mono") +
# geom_segment(aes(x = 1, xend = 1, y = 3.1, yend = 68), color = segcolor, alpha = 0.6) +
#BLACK
geom_text(data = df %>% filter(Race == "Black" & abbr == "NJ"), aes(label = abbr), color = "black", vjust = "center", nudge_x = 0.15, family = "PT Mono") +
geom_text(data = df %>% filter(Race == "Black" & abbr == "CA"), aes(label = abbr), color = "black", vjust = "center", nudge_x = 0.15, family = "PT Mono") +
# geom_text(data = df %>% filter(Race == "Black" & abbr == "NJ"), aes(label = "Black"), color = "black", vjust = "top", hjust = "center", nudge_y = 5, size = 4, face = "bold", family = "PT Mono") +
# geom_segment(aes(x = 2, xend = 2, y = 17.4, yend = 102.3), color = segcolor, alpha = 0.6) +
#WHITE
geom_text(data = df %>% filter(Race == "White" & abbr == "MA"), aes(label = abbr), color = "black", vjust = "center", nudge_x = 0.15, family = "PT Mono") +
geom_text(data = df %>% filter(Race == "White" & abbr == "GA"), aes(label = abbr), color = "black", vjust = "center", nudge_x = 0.15, family = "PT Mono") +
# geom_text(data = df %>% filter(Race == "White" & abbr == "GA"), aes(label = "White"), color = "black", vjust = "top", hjust = "center", nudge_y = 5, size = 4, face = "bold", family = "PT Mono") +
# geom_segment(aes(x = 3, xend = 3, y = 4.4, yend = 43.2), color = segcolor, alpha = 0.6) +
scale_colour_manual(values = racecolors) +
geom_point(size = 1.5, color = "black") +
geom_hline(yintercept = 20.7, linetype = "dashed", color = segcolor) +
labs(title = "Black women in the U.S. face higher maternal mortality",
subtitle = "Maternal deaths per 100,000 live births, in 2018",
caption = "Source(s): America's Health Rankings") +
xlab("Race") +
ylab("Deaths per 100,000 live births") +
theme(
axis.title = element_text(size = 12, family = "PT Mono", face = "bold", color = "black"),
axis.title.x = element_text(margin = margin(t=1.5, r=0, b=0, l=0, unit="cm")),
axis.title.y = element_text(margin = margin(t=0, r=0.5, b=0, l=0, unit="cm")),
axis.text = element_text(size = 10, family = "PT Mono", color = "black"),
axis.text.x = element_text(margin = margin(t=1, r=0, b=0, l=0, unit="cm")),
axis.ticks = element_blank(),
legend.position = "none",
panel.border = element_blank(),
panel.background = element_rect(fill = "#F7F7F7"),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.y = element_line(color = "#EBEBEB"),
panel.grid.minor.y = element_blank(),
plot.title = element_text(size = 21, family = "Raleway", face = "bold"),
plot.subtitle = element_text(size = 12, family = "PT Mono",
margin = margin(t=0,r=0,b=1.5,l=0,unit="cm")),
plot.caption = element_text(size = 8,
family = "PT Mono",
margin = margin(t=1.5,r=0,b=0,l=0,unit="cm"),
hjust = 1),
plot.margin = unit(c(1,1,1,1),"cm"),
plot.background = element_rect(fill = "#F7F7F7")
) +
coord_cartesian(clip = "off") +
annotate("text", x = 4, y = 18, label = "2018:\nU.S. ratio was\n20.7 deaths per\n100,000 live births", size = 3, hjust = "right", vjust = "top", family = "PT Mono") +
annotate("point", x = 3.37, y = 95, size = 5, alpha = 0.7, color = "grey") +
annotate("point", x = 3.37, y = 95, size = 1.5, color = "black") +
annotate("text", x = 3.4, y = 95, hjust = "left", label = " = one state", family = "PT Mono")
Noticeably, Black women in the U.S. are dying at higher ratios of maternal mortality, having at its highest point 102.3 deaths per 100,000 live births in the state of New Jersey. Where states are represented by dots on this graph, there is minimal state collection/reporting of maternal mortality by race. Most data is collected on Black and White women (24 and 37 state observations, respectively). Note: American Indian/Alaskan Native women were not visualized on this graph because of minimal data.
Data Source(s):
- The World Bank:
- The World Health Organization: https://www.who.int/reproductivehealth/publications/monitoring/maternal-mortality-2015/en/
- America’s Health Rankings: https://www.americashealthrankings.org/explore/health-of-women-and-children/measure/maternal_mortality/state/ALL
- U.S. shapefile: https://www.arcgis.com/home/item.html?id=f7f805eb65eb4ab787a0a3e1116ca7e5
- Our World in Data: https://ourworldindata.org/maternal-mortality#data-quality-definition